home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Applications / ircle 1.5.1 / source / ircle sources / IRCHelp.p < prev    next >
Encoding:
Text File  |  1993-10-30  |  3.1 KB  |  137 lines  |  [TEXT/PJMM]

  1. {    ircle - Internet Relay Chat client    }
  2. {    File: IRCHelp    }
  3. {    Copyright © 1992 Olaf Titz (s_titz@ira.uka.de)    }
  4.  
  5. {    This program is free software; you can redistribute it and/or modify    }
  6. {    it under the terms of the GNU General Public License as published by    }
  7. {    the Free Software Foundation; either version 2 of the License, or    }
  8. {    (at your option) any later version.    }
  9.  
  10. {    This program is distributed in the hope that it will be useful,    }
  11. {    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
  12. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
  13. {    GNU General Public License for more details.    }
  14.  
  15. {    You should have received a copy of the GNU General Public License    }
  16. {    along with this program; if not, write to the Free Software    }
  17. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }
  18.  
  19. unit IRCHelp;
  20. { About and Help functions }
  21.  
  22. interface
  23. uses
  24.     TCPTypes, TCPStuff, TCPConnections, ApplBase, MiscGlue, MsgWindows, {}
  25.     IRCGlobals, IRCChannels;
  26.  
  27. procedure InitIRCHelp;
  28. { Startup }
  29.  
  30. procedure ShowHelp;
  31. { Show HELP Window }
  32.  
  33. implementation
  34.  
  35. var
  36.     dia: DialogPtr;    { About dialog box }
  37.     hel: MWHndl;    { Help window }
  38.  
  39. procedure closehelp (w: WindowPtr);
  40.     begin
  41.         DeleteMWindow(hel);
  42.         hel := nil
  43.     end;
  44.  
  45. procedure GetVersion (var s: string);
  46.     type
  47.         vers = record
  48.                 v, st, l: integer;
  49.             end;
  50.         versPtr = ^vers;
  51.         versHndl = ^versPtr;
  52.     var
  53.         vh: VersHndl;
  54.     begin
  55.         vh := VersHndl(GetResource('vers', 1));
  56.         if vh <> nil then begin
  57.             with vh^^ do begin
  58.                 s := concat(char(v div 256 + 48), '.', chr((v div 16) mod 16 + 48));
  59.                 if (v mod 16) <> 0 then
  60.                     s := concat(s, '.', chr(v mod 16 + 48));
  61.             end;
  62.             case (vh^^.st div 8192) of
  63.                 1: 
  64.                     s := concat(s, ' (development)');
  65.                 2: 
  66.                     s := concat(s, ' (alpha)');
  67.                 3: 
  68.                     s := concat(s, ' (beta)');
  69.                 4: 
  70.                     ;
  71.             end;
  72.             ReleaseResource(Handle(vh));
  73.         end
  74.     end;
  75.  
  76. procedure ShowHelp;
  77.     var
  78.         st: str255;
  79.         ht, hs: Handle;
  80.         r: rect;
  81.     begin
  82.         if hel = nil then begin
  83. { The Help function consists of just loading the complete text into a window }
  84. { Sorry, no fancy section selector or hyperlinks. }
  85. { These are the things I am too lazy to write }
  86.             ht := GetResource('TEXT', 128);
  87.             hs := GetResource('styl', 128);
  88.             if (ht <> nil) and (hs <> nil) then begin
  89.                 st := 'Help';
  90.                 SetRect(r, 0, 0, 0, 0);
  91.                 hel := NewMWindow(st, r, @closehelp);
  92.                 if hel <> nil then begin
  93.                     HLock(ht);
  94.                     TEStylInsert(ht^, GetHandleSize(ht), stScrpHandle(hs), hel^^.t);
  95.                     HUnlock(ht);
  96.                     ReleaseResource(ht);
  97.                     ReleaseResource(hs);
  98.                     SetCtlMax(hel^^.vscr, hel^^.t^^.nlines - hel^^.vislines);
  99.                     exit(ShowHelp)
  100.                 end
  101.             end;
  102.             StatusMsg(E_NOHELP);
  103.         end
  104.         else
  105.             SelectWindow(hel^^.w);
  106.     end;
  107.  
  108.  
  109. function Menu256 (var e: EventRecord): boolean;
  110.     var
  111.         i: integer;
  112.     begin
  113.         if e.message = 1 then begin
  114.             ParamText(CL_VERSION, '', '', '');
  115.             SetDAFont(courier);
  116.             i := Alert(A_INFO, nil);
  117.             SetDAFont(0);
  118.             if i = 2 then begin
  119.                 ShowHelp;
  120.                 Menu256 := true
  121.             end
  122.             else
  123.                 Menu256 := false;
  124.         end;
  125.     end;
  126.  
  127. procedure InitIRCHelp;
  128.     var
  129.         i: integer;
  130.     begin
  131.         i := ApplTask(@Menu256, menuMsg + 256);
  132.         dia := nil;
  133.         hel := nil;
  134.         GetVersion(CL_VERSION)
  135.     end;
  136.  
  137. end.